home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMIBEST1.ADF
/
AmigaBasicStuff
/
Decoder
/
Compactor
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1987-07-22
|
5KB
|
123 lines
REM Compactor
REM Steve Michel 9/15/86 815-626-4157
REM 2510 16th Ave. Sterling IL 61081
REM get file name to compact
CLS: PRINT
INPUT "Enter filename to compact";filename.in$
PRINT: INPUT "Enter filename for compacted file"; filename.out$
OPEN "I", #1, filename.in$, 1024
OPEN "O", #2, filename.out$, 1024
CLS: PRINT: PRINT "Now reading line => "
PRINT: PRINT "Now writing line => "
DIM byte$(300) ' assumes a single line not longer than 300 bytes
lines.in = 0: lines.out = 0: bytes.in = 0: bytes.out = 0
REM directly copy file attribute bytes
a$ = INPUT$ (1,#1): PRINT #2,a$;
a$ = INPUT$ (1,#1): PRINT #2,a$;
REM start main read / write loop
loop:
byte$(1) = INPUT$ (1,#1) ' get linelength
linelength = ASC(byte$(1)) ' check for end of BASIC text
IF linelength = 0 THEN end.of.basic ' if linelength is zero
' we're at end of basic text
REM read in line from input file
' not end of BASIC text, so
bytes.in = bytes.in + linelength ' count bytes in and
lines.in = lines.in + 1 ' increment line counter
LOCATE 2,22: PRINT lines.in ' and print it to screen
FOR J = 2 TO linelength ' read rest of line one byte
byte$(J) = INPUT$ (1,#1) ' at a time into the
NEXT J ' array - byte$()
REM check for blank line
byte3 = ASC(byte$(3)) ' check bytes 3 & 4 of line for
byte4 = ASC(byte$(4)) ' two zeros that indicate a
IF byte3 = 0 AND byte4 = 0 THEN loop ' blank line. if yes, skip line
REM check for leading apostrophe
IF byte3 = 58 AND byte4 = 7*25 THEN loop ' leading apostrophe. so skip
REM scan current line for imbedded REMs and '
newlength = 0 ' no leading REMs or apostrophes
FOR J = 3 TO linelength ' so search for imbedded REMs
IF byte$(J) = CHR$(174+1) THEN ' and apostrophes. if found,
newlength = J ' set position found and force
J = 1e+09 ' the loop to end
END IF
NEXT J
IF newlength = 0 THEN setup.line ' no REMs found so save line
REM embedded REM found, check for colon in front of it
FOR J = newlength TO 3 STEP -1 ' start searching line backwards
IF byte$(J) = CHR$(58) THEN ' for a colon. if found, set
linelength = J + 1 ' linelength to that position
GOTO setup.line ' plus 1 and end search and
END IF ' setup line to write to new
NEXT J ' file
GOTO loop ' no colon, so skip whole line
REM this routine sets up the line length, indentation and
REM two zero bytes at the end of the compacted line
setup.line:
byte$(1) = CHR$(linelength) ' reset line length
byte$(2) = CHR$(0) ' reset line indentation
byte$(linelength) = CHR$(0) ' set two zero bytes at the
byte$(linelength-1) = CHR$(0) ' end of the line
bytes.out = bytes.out + linelength ' count # of bytes written
lines.out = lines.out + 1 ' keep track of lines written
LOCATE 4,22: PRINT lines.out ' and display on screen
FOR J = 1 TO linelength ' now write whole line out to
PRINT #2, byte$(J); ' to compacted file
NEXT J
GOTO loop ' and continue
REM add 2 zero bytes for end of BASIC and check for
REM ODD / EVEN file lengths and adjust if needed
end.of.basic:
byte$ = INPUT$(1,#1) ' get 2nd zero byte from file
IF bytes.in/2 = INT(bytes.in/2) THEN ' if even number of bytes read,
throwaway$ = INPUT$ (1,#1) ' get rid of extra byte in front
END IF ' of variable table
PRINT #2,CHR$(0); ' write the end of BASIC markers
PRINT #2,CHR$(0);
IF bytes.out/2 = INT(bytes.out/2) THEN ' if even number of bytes written,
PRINT #2,CHR$(ASC("J")); ' add extra byte in front of
END IF ' variable table. (Thanks, Jay.)
REM copy variable table and icon files over
finish.up:
GOSUB copy.rest ' copy rest of file
OPEN "I", #1, filename.in$ + ".info" ' copy icon information
OPEN "O", #2, filename.out$ + ".info" ' to provide a clickable icon
GOSUB copy.rest ' copy icon file
KILL filename.out$ + ".info.info" ' delete extraneous file
LOCATE 6,1: PRINT "All done !" ' generated during copy process
END ' and voila !!!
copy.rest:
byte$ = INPUT$ (1,#1) ' get next byte of old file
PRINT #2, byte$; ' send to new file
IF EOF(1) THEN ' check end of old file
CLOSE #1 ' done, so tidy everything up
CLOSE #2
RETURN ' and go back
END IF
GOTO copy.rest ' otherwise, continue copying